home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 2 / LSD and 17bit Compendium Deluxe - Volume II.iso / a / prog / misc / guienv374.lha / GUIEnvironment / M2Amiga / Examples / NotifyExample.mod < prev    next >
Text File  |  1994-10-31  |  15KB  |  357 lines
  1. (****************************************************************************
  2.  
  3. $RCSfile: NotifyExample.mod $
  4.  
  5. $Revision: 1.5 $
  6.     $Date: 1994/10/31 17:11:45 $
  7.  
  8.     GUIEnvironment example: Notify functions
  9.  
  10.     M2Amiga Modula-2 Compiler V4.3
  11.  
  12.   Copyright © 1994, Carsten Ziegeler
  13.                     Augustin-Wibbelt-Str.7, 33106 Paderborn, Germany
  14.  
  15. ****************************************************************************)
  16. MODULE NotifyExample;
  17.  
  18. (* Let's open an own hires-pal-screen with a full-sized window. All gadget-
  19.    kinds from GADTools are displayed. The results will be printed using
  20.    InOut (It's the easiest way !) !*)
  21.  
  22. (* NotifyExample uses the following catalog strings 1.. : gadgets
  23.                                                     30..: menus
  24.                                                     50..: misc
  25.                                                     100 : END       *)
  26.  
  27.   FROM SYSTEM     IMPORT ADDRESS, ADR, ASSEMBLE, CAST, TAG, REG;
  28.   FROM Arts       IMPORT Assert;
  29.   FROM ExecD      IMPORT MemReqSet, MemReqs, MinList, Node;
  30.   FROM ExecL      IMPORT AllocMem, FreeMem, RemTail, Insert;
  31.   FROM GadToolsD  IMPORT stringKind, integerKind, mxKind, checkboxKind,
  32.                          cycleKind, GtTags, NewGadgetFlagSet, NewGadgetFlags,
  33.                          nmTitle, nmItem, buttonKind, textKind, listviewKind,
  34.                          scrollerKind, sliderKind, paletteKind;
  35.   FROM InOut      IMPORT WriteString, WriteLn, WriteInt, WriteCard;
  36.   FROM IntuitionD IMPORT WindowPtr, ScreenPtr, WindowFlagSet, WindowFlags,
  37.                          IDCMPFlagSet, IDCMPFlags, GaTags, lorientHoriz,
  38.                          PgaTags, SaTags;
  39.   FROM String     IMPORT Copy;
  40.  
  41.  
  42. IMPORT D : GUIEnvD,
  43.        L : GUIEnvL,
  44.        GS: GUIEnvSupport;
  45.  
  46. TYPE CycleArr    = ARRAY[0..4] OF ADDRESS;
  47.      MxArr       = ARRAY[0..3] OF ADDRESS;
  48.      ListViewArr = ARRAY[0..9] OF ADDRESS;
  49.  
  50.      STRPTR   = POINTER TO ARRAY[0..255] OF CHAR;
  51.      INTPTR   = POINTER TO INTEGER;
  52.  
  53.      ListViewNode = Node;
  54.      ListViewNodePtr = POINTER TO ListViewNode;
  55.  
  56. CONST listviewLabs = ListViewArr{ADR("Amiga 500"), ADR("Amiga 500+"),
  57.                        ADR("Amiga 600"), ADR("Amiga 1000"),
  58.                        ADR("Amiga 1200"), ADR("Amiga 2000"),
  59.                        ADR("Amiga 3000"), ADR("Amiga 4000/030"),
  60.                        ADR("Amiga 4000/040"), ADR("Amiga XXXX/yyy")};
  61.  
  62.       version = ADR("$VER: NotifyExample 37.4 (31.10.94)\n");
  63.  
  64. VAR S : ScreenPtr;
  65.     W : WindowPtr;
  66.     G : D.GUIInfoPtr;  (* The most important one *)
  67.  
  68.     buffer : ARRAY[0..22] OF LONGCARD; (* Will contain all the tags *)
  69.     list   : MinList;        (* List for ListviewKind-Gadget *)
  70.     entry  : ListViewNodePtr;
  71.     i : INTEGER;
  72.  
  73. (* Variables for the entry-fields *)
  74.     string : ARRAY[0..79] OF CHAR;
  75.     longI  : LONGINT;
  76.     cycle  : CARDINAL;
  77.     mx     : CARDINAL;
  78.     check  : BOOLEAN;
  79.     listview : CARDINAL;
  80.     scroller : INTEGER;
  81.     slider   : INTEGER;
  82.     color    : CARDINAL;
  83.  
  84.     cycleLabs := CycleArr{ADR("ZERO"), ADR("ONE"), ADR("TWO"),
  85.                           ADR("THREE"), NIL};
  86.     mxLabs  := MxArr{ADR("Man"), ADR("Woman"), ADR("Child"), NIL};
  87.  
  88.  
  89.   (* ATTENTION: Remember, that all these hook functions are in fact
  90.                 real Amiga callback hooks, so they all get in A0 the
  91.                 hook structure and in A1/A2 the parameters. But as
  92.                 we don't need these, the hook functions don't use
  93.                 them ! *)
  94.  
  95.   (* Hook-Function, so we can use also chars which are not letters as
  96.      key-equivalents *)
  97.   PROCEDURE VanKeyHookFct(charCode{10} : LONGINT) : LONGINT;
  98.   (* We get in A2 the character (as a LONGINT) and we return gehKeyUnknown
  99.      for unknown key equivalents and otherwise the gadget number *)
  100.   VAR return : LONGINT;
  101.   BEGIN
  102.     (* MXKind gadgets do not support gadget-text, so we have to immitate
  103.        the key-equivalent.
  104.        We also use for the sliderKind gadget a key-equivalent with the
  105.        + and - keys *)
  106.     CASE CHAR(charCode) OF
  107.       'm' : return := 9;
  108.     | 'M' : return := 9 + D.gehKeyShifted;
  109.     | '+' : return := 8;
  110.     | '-' : return := 8 + D.gehKeyShifted;
  111.     ELSE
  112.       return := D.gehKeyUnknown;
  113.     END;
  114.     RETURN return;
  115.   END VanKeyHookFct;
  116.  
  117. (* Menu-Functions :
  118.    Usually you have to set LoadA4:=TRUE to have access to all functions
  119.    and variables. GUIEnv does this for us !
  120.    If the result is TRUE, GUIEnv will stay in the waiting-loop, otherwise
  121.    it will return ! *)
  122.  
  123.   PROCEDURE MenuAbout():BOOLEAN;
  124.   BEGIN
  125.     IGNORE L.GUIRequestA(G, L.GetCatStr(G, 51,
  126.                          ADR("GUIEnvironment example for version 37.4\n© 1994 C. Ziegeler")),
  127.                          D.gerRTOKKind, NIL);
  128.     (* the return value of a gerOKKind is always 0 *)
  129.     RETURN TRUE;
  130.   END MenuAbout;
  131.  
  132.   PROCEDURE MenuQuit():BOOLEAN;
  133.   BEGIN
  134.     RETURN L.GUIRequestA(G, L.GetCatStr(G, 52, ADR("Really quit example ?")),
  135.                          D.gerRTDoItKind, TAG(buffer,
  136.                          D.gerGadgets, L.GetCatStr(G, 53, ADR("YES|NO")), NIL)) # D.gerYes;
  137.   END MenuQuit;
  138.  
  139. BEGIN
  140.  
  141.   (* Init liste / same as NewList(ADR(list)) *)
  142.   ASSEMBLE(LEA     list(A4), A0
  143.            MOVE.L  A0,(A0)
  144.            ADDQ.L  #4,(A0)
  145.            CLR.L   4(A0)
  146.            MOVE.L  A0,8(A0)
  147.   END);
  148.  
  149.   FOR i := 0 TO 9 DO     (* make the list-entries *)
  150.     entry := AllocMem(SIZE(ListViewNode), MemReqSet{memClear});
  151.     IF entry # NIL THEN
  152.       entry^.name := listviewLabs[i];
  153.       Insert(ADR(list), entry, NIL);
  154.     END;
  155.   END;
  156.  
  157.   (* set the values *)
  158.   (* the string variable is set later because of localization ! *)
  159.   longI  := 33106;
  160.   cycle  := 2;
  161.   mx     := 1;
  162.   check  := TRUE;
  163.   listview := 65535;
  164.   scroller := 1;
  165.   slider   := 5;
  166.   color    := 0;
  167.  
  168.   (* open screen with Topaz/8-Font! *)
  169.   S := L.OpenGUIScreenA(GS.gesHiresPalID, 2, ADR("GUIEnvExample_Screen"),
  170.                         TAG(buffer, saFont, GS.TopazAttr(), NIL));
  171.   IF S # NIL THEN
  172.     (* And now a full-sized window *)
  173.     W := L.OpenGUIWindowA(0, 0, 640, 256, ADR("GUIEnvironment - NotifyExample"),
  174.                           IDCMPFlagSet{closeWindow, gadgetUp, gadgetDown,
  175.                                        menuPick, refreshWindow, vanillaKey},
  176.                           WindowFlagSet{windowClose, activate}, S,
  177.                           TAG(buffer, D.gewOuterSize, TRUE, NIL));
  178.     IF W # NIL THEN
  179.       (* create GUIInfo *)
  180.       G := L.CreateGUIInfoA(W, TAG(buffer,
  181.                             D.guiVanKeyAHook, ADR(VanKeyHookFct),
  182.                             D.guiCatalogFile, ADR("GUIEnvExamples.catalog"),
  183.                             D.guiGadgetCatalogOffset, 1,
  184.                             D.guiMenuCatalogOffset, 30, NIL));
  185.  
  186.       IF G # NIL THEN
  187.  
  188.         (* Is the locale.library installed and the catalog available,
  189.            so change the texts for the cycle and mx gadget *)
  190.         FOR i := 0 TO 3 DO
  191.           cycleLabs[i] := L.GetCatStr(G, 54+i, cycleLabs[i]);
  192.         END;
  193.         FOR i := 0 TO 2 DO
  194.           mxLabs[i] := L.GetCatStr(G, 58+i, mxLabs[i]);
  195.         END;
  196.         Copy(string, STRPTR(L.GetCatStr(G, 68, ADR("This is a text-line !")))^);
  197.  
  198.         (* If this gadget receives a gadgetUp message, GUIEnv will
  199.            call the given function. Only if this returns FALSE
  200.            GUIEnv will send this message to our message port !! *)
  201.         L.CreateGUIGadgetA(G, 500, 190, 80, 20, buttonKind,
  202.                            TAG(buffer,D.gegFlags, NewGadgetFlagSet{placetextIn},
  203.                                       D.gegText, ADR("_QUIT"),
  204.                                       D.gegUpAHook, ADR(MenuQuit),
  205.                                       D.gegDownAHook, ADR(MenuQuit), NIL));
  206.         L.CreateGUIGadgetA(G, 100, 10, 200, 13, stringKind,
  207.                            TAG(buffer, D.gegText, ADR("S_tring:"),
  208.                                        D.gegFlags, NewGadgetFlagSet{placetextLeft},
  209.                                        D.gegVarAddress, ADR(string),
  210.                                        D.gegStartChain, FALSE,
  211.                                        gtstMaxChars, 80, NIL));
  212.         L.CreateGUIGadgetA(G, 100, 30,  80, 13, integerKind,
  213.                            TAG(buffer, D.gegVarAddress, ADR(longI), (* NOTIFY ! *)
  214.                                        D.gegText, ADR("_Longint:"),
  215.                                        D.gegFlags, NewGadgetFlagSet{placetextLeft},
  216.                                        D.gegEndChain, TRUE,
  217.                                        gtinMaxChars, 7, NIL));
  218.         L.CreateGUIGadgetA(G, 100, 50,  80,15, cycleKind,
  219.                            TAG(buffer, D.gegVarAddress, ADR(cycle), (* NOTIFY *)
  220.                                        D.gegText, ADR("C_ycle It:"),
  221.                                        D.gegFlags, NewGadgetFlagSet{placetextLeft},
  222.                                        gtcyLabels, ADR(cycleLabs), NIL));
  223.         L.CreateGUIGadgetA(G, 270, 90,  0, 0, checkboxKind,
  224.                            TAG(buffer, D.gegVarAddress, ADR(check), (* NOTIFY *)
  225.                                        D.gegFlags, NewGadgetFlagSet{placetextLeft},
  226.                                        D.gegText, ADR("_Check it:"), NIL));
  227.         L.CreateGUIGadgetA(G, 320, 30, 200, 80, listviewKind,
  228.                            TAG(buffer, D.gegVarAddress, ADR(listview),
  229.                                        D.gegText, ADR("Choose List_view-Entry"),
  230.                                        D.gegFlags, NewGadgetFlagSet{placetextAbove},
  231.                                        gtlvLabels, ADR(list),
  232.                                        gtlvShowSelected, NIL, NIL));
  233.         L.CreateGUIGadgetA(G, 20, 130, 600, 14, scrollerKind,
  234.                            TAG(buffer, D.gegText, ADR("_Scroll Me"),
  235.                                        D.gegFlags, NewGadgetFlagSet{placetextAbove},
  236.                                        D.gegVarAddress, ADR(scroller),
  237.                                        gtscTotal, 100,
  238.                                        gaImmediate, TRUE,
  239.                                        gaRelVerify, TRUE,
  240.                                        pgaFreedom, lorientHoriz, NIL));
  241.         L.CreateGUIGadgetA(G, 120, 200, 250, 35, paletteKind,
  242.                            TAG(buffer, D.gegText, ADR("This is a _palette !"),
  243.                                        D.gegFlags, NewGadgetFlagSet{placetextAbove},
  244.                                        gtpaDepth, 2,
  245.                                        D.gegVarAddress, ADR(color),
  246.                                        gtpaIndicatorWidth, 50, NIL));
  247.         L.CreateGUIGadgetA(G, 20, 170, 600, 14, sliderKind,
  248.                            TAG(buffer, D.gegText, ADR("Slider me with + and -"),
  249.                                        D.gegFlags, NewGadgetFlagSet{placetextAbove},
  250.                                        gtslMin, 0,
  251.                                        gtslMax, 200,
  252.                                        D.gegVarAddress, ADR(slider),
  253.                                        gaImmediate, TRUE,
  254.                                        gaRelVerify, TRUE,
  255.                                        pgaFreedom, lorientHoriz, NIL));
  256.         L.CreateGUIGadgetA(G, 100, 80,  80,17, mxKind,
  257.                            TAG(buffer, D.gegFlags, NewGadgetFlagSet{placetextLeft},
  258.                                        D.gegVarAddress, ADR(mx), (* NOTIFY *)
  259.                                        gtmxLabels, ADR(mxLabs), NIL));
  260.         L.CreateGUIGadgetA(G, 120, 68,  10,12, textKind,
  261.                            TAG(buffer, D.gegText, ADR("MX:"),
  262.                                        D.gegFlags, NewGadgetFlagSet{placetextLeft},
  263.                                        gttxText, L.GetCatStr(G, 50, ADR("Try pressing m")), NIL));
  264.  
  265.         L.CreateGUIMenuEntryA(G, nmTitle, ADR("Project"), NIL);
  266.         L.CreateGUIMenuEntryA(G, nmItem, ADR("About"),
  267.                           TAG(buffer, D.gemAHook, ADR(MenuAbout),
  268.                                       D.gemShortCut, ADR("A\o"), NIL));
  269.         L.CreateGUIMenuEntryA(G, nmItem, ADR("Quit"),
  270.                           TAG(buffer, D.gemAHook, ADR(MenuQuit),
  271.                                       D.gemShortCut, ADR("Q\o"), NIL));
  272.  
  273.         IF L.DrawGUIA(G, NIL) = D.geDone THEN (* Draw all *)
  274.  
  275.           LOOP (* Input-Loop *)
  276.             L.WaitGUIMsg(G);
  277.             IF    closeWindow IN G^.msgClass THEN
  278.               IF ~MenuQuit() THEN EXIT END;
  279.             ELSIF (gadgetUp IN G^.msgClass) OR (gadgetDown IN G^.msgClass) THEN
  280.               (* We are only interessed in the buttonGadget !*)
  281.               IF G^.msgGadNbr = 0 THEN  (* ButtonGadget Quit *)
  282.                 EXIT;
  283.               END;
  284.             ELSIF menuPick IN G^.msgClass THEN
  285.               (* The procedurs are automatically called within WaitGUIMsg *)
  286.               EXIT;
  287.             END;
  288.           END;
  289.  
  290.           (* update entry-gadgets *)
  291.           L.GUIGadgetActionA(G, TAG(buffer, D.gegGetVar, D.gegALLGADGETS, NIL));
  292.  
  293.           (* And now print all values *)
  294.           WriteLn;
  295.           WriteString(STRPTR(L.GetCatStr(G, 61, ADR("Your input:")))^);
  296.           WriteLn;
  297.           WriteString(STRPTR(L.GetCatStr(G, 62, ADR("String  :")))^);
  298.           WriteString(string);
  299.           WriteLn;
  300.  
  301.           WriteString(STRPTR(L.GetCatStr(G, 63, ADR("Longint :")))^);
  302.           WriteInt(longI, 1);
  303.           WriteLn;
  304.  
  305.           WriteString("Cycle   :");
  306.           WriteString(CAST(STRPTR, cycleLabs[cycle])^);
  307.           WriteLn;
  308.  
  309.           WriteString("MX      :");
  310.           WriteString(CAST(STRPTR, mxLabs[mx])^);
  311.           WriteLn;
  312.  
  313.           IF check THEN
  314.             WriteString(STRPTR(L.GetCatStr(G, 64, ADR("Checkbox:YES")))^);
  315.           ELSE
  316.             WriteString(STRPTR(L.GetCatStr(G, 65, ADR("Checkbox:NO")))^);
  317.           END;
  318.           WriteLn;
  319.  
  320.           WriteString("Listview:");
  321.           IF listview = 65535 THEN
  322.             WriteString(STRPTR(L.GetCatStr(G, 66, ADR("Nothing")))^);
  323.           ELSE
  324.             WriteString(CAST(STRPTR, listviewLabs[9-listview])^);
  325.             (* The list was created in reverse order ! *)
  326.           END;
  327.           WriteLn;
  328.  
  329.           WriteString("Slider  :");
  330.           WriteInt(slider, 1);
  331.           WriteLn;
  332.  
  333.           WriteString("Scroller:");
  334.           WriteInt(scroller, 1);
  335.           WriteLn;
  336.  
  337.           WriteString(STRPTR(L.GetCatStr(G, 67, ADR("Color   :")))^);
  338.           WriteCard(color, 1);
  339.           WriteLn;
  340.  
  341.           WriteLn;
  342.         END;
  343.       END;
  344.     END;
  345.   END;
  346.  
  347. CLOSE
  348.   IF S # NIL THEN
  349.     L.CloseGUIScreen(S); (* The closing of the window etc is done by GUIEnv !*)
  350.   END;
  351.   IF list.tailPred # NIL THEN  (* Did we reach the InitList ? *)
  352.     WHILE list.tailPred # ADR(list) DO    (* free list *)
  353.       FreeMem(RemTail(ADR(list)), SIZE(ListViewNode));
  354.     END;
  355.   END;
  356. END NotifyExample.
  357.